home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / FOSUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-12-23  |  8KB  |  355 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....}
  13.  
  14. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  15. UNIT FOSUNIT;
  16.  
  17. INTERFACE
  18.  
  19. USES DOS;
  20.  
  21. TYPE
  22.  ASCIZ_id = ARRAY[1..128] OF CHAR;
  23.  ascizptr = ^asciz_id;
  24.  
  25.  fossildatatype = RECORD
  26.         strsize : WORD;
  27.          majver : BYTE;
  28.          minver : BYTE;
  29.           ident : ascizPtr;
  30.           ibufr : WORD;
  31.           ifree : WORD;
  32.           obufr : WORD;
  33.           ofree : WORD;
  34.          swidth : BYTE;
  35.         sheight : BYTE;
  36.            baud : BYTE;
  37.  END;
  38.  
  39. VAR
  40.  port_num   : INTEGER;
  41.  fossildata : fossildatatype;
  42.  
  43. PROCEDURE async_send(c : CHAR);
  44. PROCEDURE async_send_string(s : STRING);
  45. FUNCTION  async_receive(VAR ch : CHAR) : BOOLEAN;
  46. FUNCTION  async_carrier_drop : BOOLEAN;
  47. FUNCTION  async_carrier_present : BOOLEAN;
  48. FUNCTION  async_buffer_check : BOOLEAN;
  49. FUNCTION  async_init_fossil : BOOLEAN;
  50. PROCEDURE async_deinit_fossil;
  51. PROCEDURE async_flush_output;
  52. PROCEDURE async_purge_output;
  53. PROCEDURE async_purge_input;
  54. PROCEDURE async_set_dtr(state : BOOLEAN);
  55. PROCEDURE async_watchdog_on;
  56. PROCEDURE async_watchdog_off;
  57. PROCEDURE async_warm_reboot;
  58. PROCEDURE async_cold_reboot;
  59. PROCEDURE async_set_baud(n : LONGINT);
  60. PROCEDURE async_set_baudBnu(n : LONGINT);
  61. PROCEDURE async_set_flow(SoftTran,Hard,SoftRecv : BOOLEAN);
  62. PROCEDURE async_buffer_status(VAR Insize,Infree,OutSize,Outfree : WORD;
  63.                               VAR fossilname : STRING);
  64.  
  65. IMPLEMENTATION
  66.  
  67. PROCEDURE async_send(c : CHAR);
  68. VAR
  69.  regs : REGISTERS;
  70. BEGIN;
  71.  WITH regs DO
  72.   BEGIN
  73.     ah := $01;
  74.     al := BYTE(c);
  75.     dx := port_num;
  76.   END;
  77.  INTR($14,regs);
  78. END;
  79.  
  80. PROCEDURE async_send_string(s : STRING);
  81. VAR
  82.  a : INTEGER;
  83. BEGIN;
  84.  FOR a := 1 TO LENGTH(s) DO async_send(s[a]);
  85. END;
  86.  
  87. FUNCTION async_receive(VAR ch : CHAR) : BOOLEAN;
  88. VAR
  89.  regs : REGISTERS;
  90. BEGIN;
  91.  ch := #0;
  92.  regs.ah := $03;
  93.  regs.dx := port_num;
  94.  INTR($14,regs);
  95.  IF (regs.ah AND 1) = 1 THEN BEGIN;
  96.   regs.ah := $02;
  97.   regs.dx := port_num;
  98.   INTR($14,regs);
  99.   ch := CHR(regs.al);
  100.   async_receive := TRUE;
  101.  END ELSE async_receive := FALSE;
  102. END;
  103.  
  104. FUNCTION async_carrier_drop : BOOLEAN;
  105. VAR
  106.  regs : REGISTERS;
  107. BEGIN;
  108.  regs.ah := $03;
  109.  regs.dx := port_num;
  110.  INTR($14,regs);
  111.  IF (regs.al AND $80) <> 0 THEN async_carrier_drop := FALSE ELSE async_carrier_drop := TRUE;
  112. END;
  113.  
  114. FUNCTION async_carrier_present : BOOLEAN;
  115. VAR
  116.  regs : REGISTERS;
  117. BEGIN;
  118.  regs.ah := $03;
  119.  regs.dx := port_num;
  120.  INTR($14,regs);
  121.  IF (regs.al AND $80) <> 0 THEN async_carrier_present := TRUE ELSE async_carrier_present := FALSE;
  122. END;
  123.  
  124. FUNCTION async_buffer_check : BOOLEAN;
  125. VAR
  126.  regs : REGISTERS;
  127. BEGIN;
  128.  regs.ah := $03;
  129.  regs.dx := port_num;
  130.  INTR($14,regs);
  131.  IF (regs.ah AND 1) = 1 THEN async_buffer_check := TRUE ELSE async_buffer_check := FALSE;
  132. END;
  133.  
  134. FUNCTION async_init_fossil : BOOLEAN;
  135. VAR
  136.  regs : REGISTERS;
  137. BEGIN;
  138.  regs.ah := $04;
  139.  regs.bx := $00;
  140.  regs.dx := port_num;
  141.  INTR($14,regs);
  142.  IF regs.ax = $1954 THEN async_init_fossil := TRUE ELSE async_init_fossil := FALSE;
  143. END;
  144.  
  145. PROCEDURE async_deinit_fossil;
  146. VAR
  147.  regs : REGISTERS;
  148. BEGIN;
  149.  regs.ah := $05;
  150.  regs.dx := port_num;
  151.  INTR($14,regs);
  152. END;
  153.  
  154. PROCEDURE async_set_dtr(state : BOOLEAN);
  155. VAR
  156.  regs : REGISTERS;
  157. BEGIN;
  158.  regs.ah := $06;
  159.  IF state THEN regs.al := 1 ELSE regs.al := 0;
  160.  regs.dx := port_num;
  161.  INTR($14,regs);
  162. END;
  163.  
  164. PROCEDURE async_flush_output;
  165. VAR
  166.  regs : REGISTERS;
  167. BEGIN;
  168.  regs.ah := $08;
  169.  regs.dx := port_num;
  170.  INTR($14,regs);
  171. END;
  172.  
  173. PROCEDURE async_purge_output;
  174. VAR
  175.  regs : REGISTERS;
  176. BEGIN;
  177.  regs.ah := $09;
  178.  regs.dx := port_num;
  179.  INTR($14,regs);
  180. END;
  181.  
  182. PROCEDURE async_purge_input;
  183. VAR
  184.  regs : REGISTERS;
  185. BEGIN;
  186.  regs.ah := $0A;
  187.  regs.dx := port_num;
  188.  INTR($14,regs);
  189. END;
  190.  
  191. PROCEDURE async_watchdog_on;
  192. VAR
  193.  regs : REGISTERS;
  194. BEGIN;
  195.  regs.ah := $14;
  196.  regs.al := $01;
  197.  regs.dx := port_num;
  198.  INTR($14,regs);
  199. END;
  200.  
  201. PROCEDURE async_watchdog_off;
  202. VAR
  203.  regs : REGISTERS;
  204. BEGIN;
  205.  regs.ah := $14;
  206.  regs.al := $00;
  207.  regs.dx := port_num;
  208.  INTR($14,regs);
  209. END;
  210.  
  211. PROCEDURE async_warm_reboot;
  212. VAR
  213.  regs : REGISTERS;
  214. BEGIN;
  215.  regs.ah := $17;
  216.  regs.al := $01;
  217.  INTR($14,regs);
  218. END;
  219.  
  220. PROCEDURE async_cold_reboot;
  221. VAR
  222.  regs : REGISTERS;
  223. BEGIN;
  224.  regs.ah := $17;
  225.  regs.al := $00;
  226.  INTR($14,regs);
  227. END;
  228.  
  229. PROCEDURE async_set_baud(n : LONGINT);
  230. VAR
  231.  w : WORD;
  232.  regs : REGISTERS;
  233. BEGIN;
  234.  regs.ah := $00;
  235.  regs.al := $03;
  236.  regs.dx := port_num;
  237.  w := n;
  238.  
  239.  IF n > 76800 THEN         {115200 }
  240.    regs.al := regs.al OR $80
  241.  ELSE
  242.  IF n > 57600 THEN         { 76800 }
  243.    regs.al := regs.al OR $60
  244.  ELSE
  245.    CASE w OF
  246.      300  : regs.al := regs.al OR $40;
  247.      600  : regs.al := regs.al OR $60;
  248.      1200 : regs.al := regs.al OR $80;
  249.      2400 : regs.al := regs.al OR $A0;
  250.      4800 : regs.al := regs.al OR $C0;
  251.      9600 : regs.al := regs.al OR $E0;
  252.      9601..19200 :  regs.al := regs.al OR $00;
  253.      19201..38400 : regs.al := regs.al OR $20;
  254.      38401..57600 : regs.al := regs.al OR $40;
  255.    END;
  256.  
  257.  INTR($14,regs);
  258. END;
  259.  
  260. PROCEDURE async_set_baudBnu(n : LONGINT);
  261. VAR
  262.  w : WORD;
  263.  regs : REGISTERS;
  264. BEGIN;
  265.  regs.ah := $00;
  266.  regs.al := $03;
  267.  regs.dx := port_num;
  268.  w := n;
  269.  
  270.  IF n > 38400 THEN
  271.   BEGIN
  272.     IF n > 57600 THEN               {115200}
  273.       regs.al := regs.al OR $80
  274.     ELSE
  275.       regs.al := regs.al OR $60;       { 57600 }
  276.     regs.bx := $69DC;
  277.     regs.cx := $69DC;
  278.   END
  279.  ELSE
  280.    CASE w OF
  281.      300  : regs.al := regs.al OR $40;
  282.      600  : regs.al := regs.al OR $60;
  283.      1200 : regs.al := regs.al OR $80;
  284.      2400 : regs.al := regs.al OR $A0;
  285.      4800 : regs.al := regs.al OR $C0;
  286.      9600 : regs.al := regs.al OR $E0;
  287.      9601..19200 :  regs.al := regs.al OR $00;
  288.      19201..38400 : regs.al := regs.al OR $20;
  289.    END;
  290.  
  291.  INTR($14,regs);
  292. END;
  293. {
  294. The "enhanced" port rate settings are accessed by setting the both BX
  295. and CX CPU registeres to the magic value 0x69dc when calling Fn 0 (INT
  296. 14H, AH=0). This changes the meaning of the meaning of the three bits
  297. used to set the baud rate, bits 5-7, according to this table:
  298.  
  299.     Value       Standard        Enhanced (BX=CX=69DCh)
  300.     -----       --------        --------
  301.     000           19200              75
  302.     001           38400             110
  303.     010             300            7200
  304.     011             600           57600
  305.     100            1200          115200
  306.     101            2400          |
  307.     110            4800          | undefined
  308.     111            9600          |
  309.  
  310. david  }
  311.  
  312. PROCEDURE async_set_flow(SoftTran,Hard,SoftRecv : BOOLEAN);
  313. VAR
  314.  regs : REGISTERS;
  315. BEGIN;
  316.  regs.ah := $0F;
  317.  regs.al := $00;
  318.  IF softtran THEN regs.al := regs.al OR $01;
  319.  IF Hard THEN regs.al := regs.al OR $02;
  320.  IF SoftRecv THEN regs.al := regs.al OR $08;
  321.  regs.al := regs.al OR $F0;
  322.  INTR($14,regs);
  323. END;
  324.  
  325. PROCEDURE async_get_fossil_data;
  326. VAR
  327.  regs : REGISTERS;
  328. BEGIN;
  329.  regs.ah := $1B;
  330.  regs.cx := SIZEOF(fossildata);
  331.  regs.dx := port_num;
  332.  regs.es := SEG(fossildata);
  333.  regs.di := OFS(fossildata);
  334.  INTR($14,regs);
  335. END;
  336.  
  337. PROCEDURE Async_Buffer_Status(VAR Insize,Infree,OutSize,Outfree : WORD;
  338.                               VAR fossilname : STRING);
  339. VAR
  340.  i : BYTE;
  341. BEGIN;
  342.  async_get_fossil_data;
  343.  insize := fossildata.ibufr;
  344.  infree := fossildata.ifree;
  345.  outsize := fossildata.obufr;
  346.  outfree := fossildata.ofree;
  347.  i := 1;
  348.  WHILE (i < 62) AND (fossildata.ident^[i] <> #0)  DO
  349.    INC(i);
  350.  MOVE(fossildata.ident^, fossilname[1], i);
  351.  fossilname[0] := CHAR(i);
  352. END;
  353.  
  354. END.
  355.